home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / editors / postit32 / postitse.frm < prev    next >
Text File  |  1995-10-26  |  37KB  |  1,168 lines
  1. VERSION 4.00
  2. Begin VB.Form postit 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "'Post-Note - 32 Bit' ⌐1995 Numatic International"
  6.    ClientHeight    =   6936
  7.    ClientLeft      =   2292
  8.    ClientTop       =   2832
  9.    ClientWidth     =   6264
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   7.8
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   7320
  21.    Icon            =   "POSTITSE.frx":0000
  22.    Left            =   2244
  23.    LinkTopic       =   "Form1"
  24.    MaxButton       =   0   'False
  25.    ScaleHeight     =   6936
  26.    ScaleWidth      =   6264
  27.    Top             =   2496
  28.    Width           =   6360
  29.    Begin VB.TextBox DDE 
  30.       Appearance      =   0  'Flat
  31.       Height          =   612
  32.       Left            =   576
  33.       TabIndex        =   18
  34.       Text            =   "Text1"
  35.       Top             =   8160
  36.       Visible         =   0   'False
  37.       Width           =   972
  38.    End
  39.    Begin VB.TextBox DDED 
  40.       Appearance      =   0  'Flat
  41.       Height          =   612
  42.       Left            =   288
  43.       TabIndex        =   17
  44.       Text            =   "Text1"
  45.       Top             =   7296
  46.       Visible         =   0   'False
  47.       Width           =   972
  48.    End
  49.    Begin VB.TextBox ddedd 
  50.       Appearance      =   0  'Flat
  51.       Height          =   612
  52.       Left            =   1248
  53.       TabIndex        =   16
  54.       Text            =   "Text1"
  55.       Top             =   8352
  56.       Visible         =   0   'False
  57.       Width           =   972
  58.    End
  59.    Begin VB.Frame Frame1 
  60.       Caption         =   "Info..."
  61.       Height          =   588
  62.       Left            =   192
  63.       TabIndex        =   11
  64.       Top             =   6144
  65.       Width           =   5772
  66.       Begin VB.Label infotab 
  67.          Alignment       =   2  'Center
  68.          Caption         =   "Enter The Message You Wish To Send"
  69.          BeginProperty Font 
  70.             name            =   "Arial"
  71.             charset         =   0
  72.             weight          =   700
  73.             size            =   10.2
  74.             underline       =   0   'False
  75.             italic          =   0   'False
  76.             strikethrough   =   0   'False
  77.          EndProperty
  78.          Height          =   300
  79.          Left            =   96
  80.          TabIndex        =   12
  81.          Top             =   192
  82.          Width           =   5580
  83.       End
  84.    End
  85.    Begin VB.TextBox DDEDDD 
  86.       Appearance      =   0  'Flat
  87.       Height          =   612
  88.       Left            =   96
  89.       TabIndex        =   1
  90.       Text            =   "Text1"
  91.       Top             =   9216
  92.       Visible         =   0   'False
  93.       Width           =   972
  94.    End
  95.    Begin VB.TextBox DDEDDDD 
  96.       Appearance      =   0  'Flat
  97.       Height          =   612
  98.       Left            =   1152
  99.       TabIndex        =   2
  100.       Text            =   "Text1"
  101.       Top             =   9216
  102.       Visible         =   0   'False
  103.       Width           =   972
  104.    End
  105.    Begin TabDlg.SSTab SSTab1 
  106.       Height          =   6924
  107.       Left            =   0
  108.       TabIndex        =   3
  109.       Tag             =   "Enter your message you wish to send."
  110.       Top             =   0
  111.       Width           =   6252
  112.       _Version        =   65536
  113.       _ExtentX        =   11028
  114.       _ExtentY        =   12213
  115.       _StockProps     =   15
  116.       Caption         =   "Message"
  117.       BackColor       =   12632256
  118.       TabsPerRow      =   5
  119.       Tab             =   0
  120.       TabOrientation  =   0
  121.       Tabs            =   4
  122.       Style           =   0
  123.       TabMaxWidth     =   0
  124.       TabHeight       =   423
  125.       TabCaption(0)   =   "Message"
  126.       Tab(0).ControlCount=   1
  127.       Tab(0).ControlEnabled=   -1  'True
  128.       Tab(0).Control(0)=   "DATUM"
  129.       TabCaption(1)   =   "Address"
  130.       Tab(1).ControlCount=   1
  131.       Tab(1).ControlEnabled=   0   'False
  132.       Tab(1).Control(0)=   "out1"
  133.       TabCaption(2)   =   "Sound"
  134.       Tab(2).ControlCount=   1
  135.       Tab(2).ControlEnabled=   0   'False
  136.       Tab(2).Control(0)=   "SSTab2"
  137.       TabCaption(3)   =   "Send It"
  138.       Tab(3).ControlCount=   4
  139.       Tab(3).ControlEnabled=   0   'False
  140.       Tab(3).Control(0)=   "Frame3"
  141.       Tab(3).Control(1)=   "SendingTo"
  142.       Tab(3).Control(2)=   "SendIt"
  143.       Tab(3).Control(3)=   "Frame2"
  144.       Begin VB.Frame Frame3 
  145.          Height          =   972
  146.          Left            =   -74520
  147.          TabIndex        =   26
  148.          Top             =   672
  149.          Width           =   5388
  150.          Begin Threed.SSCheck REPLYREQ 
  151.             Height          =   588
  152.             Left            =   672
  153.             TabIndex        =   27
  154.             Top             =   288
  155.             Width           =   4080
  156.             _Version        =   65536
  157.             _ExtentX        =   7197
  158.             _ExtentY        =   1037
  159.             _StockProps     =   78
  160.             Caption         =   "Reply Required ?"
  161.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  162.                name            =   "Arial"
  163.                charset         =   0
  164.                weight          =   700
  165.                size            =   22.2
  166.                underline       =   0   'False
  167.                italic          =   0   'False
  168.                strikethrough   =   0   'False
  169.             EndProperty
  170.          End
  171.       End
  172.       Begin VB.Frame SendingTo 
  173.          Caption         =   "Sending Information..."
  174.          BeginProperty Font 
  175.             name            =   "Arial"
  176.             charset         =   0
  177.             weight          =   700
  178.             size            =   16.2
  179.             underline       =   0   'False
  180.             italic          =   0   'False
  181.             strikethrough   =   0   'False
  182.          EndProperty
  183.          ForeColor       =   &H000000FF&
  184.          Height          =   2700
  185.          Left            =   -74520
  186.          TabIndex        =   20
  187.          Top             =   3072
  188.          Width           =   5388
  189.          Begin VB.Label Progress 
  190.             Alignment       =   1  'Right Justify
  191.             BackStyle       =   0  'Transparent
  192.             BorderStyle     =   1  'Fixed Single
  193.             BeginProperty Font 
  194.                name            =   "Arial"
  195.                charset         =   0
  196.                weight          =   700
  197.                size            =   24
  198.                underline       =   0   'False
  199.                italic          =   0   'False
  200.                strikethrough   =   0   'False
  201.             EndProperty
  202.             Height          =   588
  203.             Left            =   288
  204.             TabIndex        =   23
  205.             Top             =   1920
  206.             Width           =   4812
  207.          End
  208.          Begin VB.Label SENDUSER 
  209.             Alignment       =   1  'Right Justify
  210.             BackStyle       =   0  'Transparent
  211.             BorderStyle     =   1  'Fixed Single
  212.             BeginProperty Font 
  213.                name            =   "Arial"
  214.                charset         =   0
  215.                weight          =   700
  216.                size            =   24
  217.                underline       =   0   'False
  218.                italic          =   0   'False
  219.                strikethrough   =   0   'False
  220.             EndProperty
  221.             Height          =   588
  222.             Left            =   288
  223.             TabIndex        =   22
  224.             Top             =   1248
  225.             Width           =   4812
  226.          End
  227.          Begin VB.Label SENDDEPARTMENT 
  228.             BackStyle       =   0  'Transparent
  229.             BorderStyle     =   1  'Fixed Single
  230.             BeginProperty Font 
  231.                name            =   "Arial"
  232.                charset         =   0
  233.                weight          =   700
  234.                size            =   18
  235.                underline       =   0   'False
  236.                italic          =   0   'False
  237.                strikethrough   =   0   'False
  238.             EndProperty
  239.             Height          =   588
  240.             Left            =   288
  241.             TabIndex        =   21
  242.             Top             =   576
  243.             Width           =   4812
  244.          End
  245.       End
  246.       Begin VB.CommandButton SendIt 
  247.          Caption         =   "Send"
  248.          BeginProperty Font 
  249.             name            =   "Arial"
  250.             charset         =   0
  251.             weight          =   700
  252.             size            =   16.2
  253.             underline       =   0   'False
  254.             italic          =   0   'False
  255.             strikethrough   =   0   'False
  256.          EndProperty
  257.          Height          =   780
  258.          Left            =   -74424
  259.          TabIndex        =   19
  260.          Top             =   1920
  261.          Width           =   5100
  262.       End
  263.       Begin VB.TextBox DATUM 
  264.          BackColor       =   &H0000FFFF&
  265.          BeginProperty Font 
  266.             name            =   "Arial"
  267.             charset         =   0
  268.             weight          =   700
  269.             size            =   13.8
  270.             underline       =   0   'False
  271.             italic          =   0   'False
  272.             strikethrough   =   0   'False
  273.          EndProperty
  274.          Height          =   5388
  275.          Left            =   288
  276.          MultiLine       =   -1  'True
  277.          ScrollBars      =   2  'Vertical
  278.          TabIndex        =   0
  279.          Text            =   "POSTITSE.frx":030A
  280.          Top             =   576
  281.          Width           =   5580
  282.       End
  283.       Begin TabDlg.SSTab SSTab2 
  284.          Height          =   5484
  285.          Left            =   -74808
  286.          TabIndex        =   4
  287.          Top             =   576
  288.          Width           =   5772
  289.          _Version        =   65536
  290.          _ExtentX        =   10181
  291.          _ExtentY        =   9673
  292.          _StockProps     =   15
  293.          Caption         =   "Custom Sounds"
  294.          BackColor       =   12632256
  295.          TabsPerRow      =   3
  296.          Tab             =   1
  297.          TabOrientation  =   0
  298.          Tabs            =   2
  299.          Style           =   0
  300.          TabMaxWidth     =   0
  301.          TabHeight       =   423
  302.          TabCaption(0)   =   "Standard Sounds"
  303.          Tab(0).ControlCount=   6
  304.          Tab(0).ControlEnabled=   0   'False
  305.          Tab(0).Control(0)=   "Popup(5)"
  306.          Tab(0).Control(1)=   "Popup(4)"
  307.          Tab(0).Control(2)=   "Popup(3)"
  308.          Tab(0).Control(3)=   "Popup(2)"
  309.          Tab(0).Control(4)=   "Popup(1)"
  310.          Tab(0).Control(5)=   "Popup(0)"
  311.          TabCaption(1)   =   "Custom Sounds"
  312.          Tab(1).ControlCount=   2
  313.          Tab(1).ControlEnabled=   -1  'True
  314.          Tab(1).Control(0)=   "Command3D3"
  315.          Tab(1).Control(1)=   "File1"
  316.          Begin VB.FileListBox File1 
  317.             Archive         =   0   'False
  318.             BackColor       =   &H0000FFFF&
  319.             Enabled         =   0   'False
  320.             BeginProperty Font 
  321.                name            =   "Arial"
  322.                charset         =   0
  323.                weight          =   700
  324.                size            =   13.8
  325.                underline       =   0   'False
  326.                italic          =   0   'False
  327.                strikethrough   =   0   'False
  328.             EndProperty
  329.             Height          =   4260
  330.             Left            =   192
  331.             ReadOnly        =   0   'False
  332.             TabIndex        =   14
  333.             Top             =   384
  334.             Width           =   5388
  335.          End
  336.          Begin Threed.SSCommand Command3D3 
  337.             Height          =   348
  338.             Left            =   768
  339.             TabIndex        =   13
  340.             Top             =   4992
  341.             Width           =   4212
  342.             _Version        =   65536
  343.             _ExtentX        =   7430
  344.             _ExtentY        =   614
  345.             _StockProps     =   78
  346.             Caption         =   "Listen To It First"
  347.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  348.                name            =   "Arial"
  349.                charset         =   0
  350.                weight          =   700
  351.                size            =   12
  352.                underline       =   0   'False
  353.                italic          =   0   'False
  354.                strikethrough   =   0   'False
  355.             EndProperty
  356.          End
  357.          Begin Threed.SSOption Popup 
  358.             Height          =   396
  359.             Index           =   0
  360.             Left            =   -73464
  361.             TabIndex        =   10
  362.             Top             =   2688
  363.             Width           =   2892
  364.             _Version        =   65536
  365.             _ExtentX        =   5101
  366.             _ExtentY        =   699
  367.             _StockProps     =   78
  368.             Caption         =   "Popup"
  369.             ForeColor       =   255
  370.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  371.                name            =   "Arial"
  372.                charset         =   0
  373.                weight          =   700
  374.                size            =   18
  375.                underline       =   0   'False
  376.                italic          =   0   'False
  377.                strikethrough   =   0   'False
  378.             EndProperty
  379.             Value           =   -1  'True
  380.          End
  381.          Begin Threed.SSOption Popup 
  382.             Height          =   396
  383.             Index           =   1
  384.             Left            =   -73464
  385.             TabIndex        =   9
  386.             TabStop         =   0   'False
  387.             Top             =   1536
  388.             Width           =   3492
  389.             _Version        =   65536
  390.             _ExtentX        =   6160
  391.             _ExtentY        =   699
  392.             _StockProps     =   78
  393.             Caption         =   "Honk-Honk"
  394.             ForeColor       =   255
  395.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  396.                name            =   "Arial"
  397.                charset         =   0
  398.                weight          =   700
  399.                size            =   18
  400.                underline       =   0   'False
  401.                italic          =   0   'False
  402.                strikethrough   =   0   'False
  403.             EndProperty
  404.          End
  405.          Begin Threed.SSOption Popup 
  406.             Height          =   396
  407.             Index           =   2
  408.             Left            =   -73464
  409.             TabIndex        =   8
  410.             TabStop         =   0   'False
  411.             Top             =   3840
  412.             Width           =   3012
  413.             _Version        =   65536
  414.             _ExtentX        =   5313
  415.             _ExtentY        =   699
  416.             _StockProps     =   78
  417.             Caption         =   "Ship-Bell"
  418.             ForeColor       =   255
  419.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  420.                name            =   "Arial"
  421.                charset         =   0
  422.                weight          =   700
  423.                size            =   18
  424.                underline       =   0   'False
  425.                italic          =   0   'False
  426.                strikethrough   =   0   'False
  427.             EndProperty
  428.          End
  429.          Begin Threed.SSOption Popup 
  430.             Height          =   396
  431.             Index           =   3
  432.             Left            =   -73464
  433.             TabIndex        =   7
  434.             TabStop         =   0   'False
  435.             Top             =   960
  436.             Width           =   2436
  437.             _Version        =   65536
  438.             _ExtentX        =   4297
  439.             _ExtentY        =   699
  440.             _StockProps     =   78
  441.             Caption         =   "Bugle"
  442.             ForeColor       =   255
  443.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  444.                name            =   "Arial"
  445.                charset         =   0
  446.                weight          =   700
  447.                size            =   18
  448.                underline       =   0   'False
  449.                italic          =   0   'False
  450.                strikethrough   =   0   'False
  451.             EndProperty
  452.          End
  453.          Begin Threed.SSOption Popup 
  454.             Height          =   396
  455.             Index           =   4
  456.             Left            =   -73464
  457.             TabIndex        =   6
  458.             TabStop         =   0   'False
  459.             Top             =   3264
  460.             Width           =   2916
  461.             _Version        =   65536
  462.             _ExtentX        =   5144
  463.             _ExtentY        =   699
  464.             _StockProps     =   78
  465.             Caption         =   "Sickness"
  466.             ForeColor       =   255
  467.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  468.                name            =   "Arial"
  469.                charset         =   0
  470.                weight          =   700
  471.                size            =   18
  472.                underline       =   0   'False
  473.                italic          =   0   'False
  474.                strikethrough   =   0   'False
  475.             EndProperty
  476.          End
  477.          Begin Threed.SSOption Popup 
  478.             Height          =   396
  479.             Index           =   5
  480.             Left            =   -73464
  481.             TabIndex        =   5
  482.             TabStop         =   0   'False
  483.             Top             =   2112
  484.             Width           =   2724
  485.             _Version        =   65536
  486.             _ExtentX        =   4805
  487.             _ExtentY        =   699
  488.             _StockProps     =   78
  489.             Caption         =   "Kitten"
  490.             ForeColor       =   255
  491.             BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  492.                name            =   "Arial"
  493.                charset         =   0
  494.                weight          =   700
  495.                size            =   18
  496.                underline       =   0   'False
  497.                italic          =   0   'False
  498.                strikethrough   =   0   'False
  499.             EndProperty
  500.          End
  501.       End
  502.       Begin VB.Frame Frame2 
  503.          Caption         =   "User Instructions.."
  504.          BeginProperty Font 
  505.             name            =   "Arial"
  506.             charset         =   0
  507.             weight          =   700
  508.             size            =   16.2
  509.             underline       =   0   'False
  510.             italic          =   0   'False
  511.             strikethrough   =   0   'False
  512.          EndProperty
  513.          ForeColor       =   &H000000FF&
  514.          Height          =   2700
  515.          Left            =   -74520
  516.          TabIndex        =   24
  517.          Top             =   3072
  518.          Width           =   5388
  519.          Begin VB.Label Label1 
  520.             Alignment       =   2  'Center
  521.             Caption         =   $"POSTITSE.frx":031D
  522.             BeginProperty Font 
  523.                name            =   "Arial"
  524.                charset         =   0
  525.                weight          =   700
  526.                size            =   16.2
  527.                underline       =   0   'False
  528.                italic          =   -1  'True
  529.                strikethrough   =   0   'False
  530.             EndProperty
  531.             Height          =   2124
  532.             Left            =   192
  533.             TabIndex        =   25
  534.             Top             =   480
  535.             Width           =   5004
  536.          End
  537.       End
  538.       Begin MSOutl.Outline out1 
  539.          Height          =   5484
  540.          Left            =   -74712
  541.          TabIndex        =   15
  542.          Top             =   576
  543.          Width           =   5580
  544.          _Version        =   65536
  545.          _ExtentX        =   9843
  546.          _ExtentY        =   9673
  547.          _StockProps     =   77
  548.          ForeColor       =   0
  549.          BackColor       =   8454143
  550.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  551.             name            =   "Arial"
  552.             charset         =   0
  553.             weight          =   700
  554.             size            =   10.8
  555.             underline       =   0   'False
  556.             italic          =   0   'False
  557.             strikethrough   =   0   'False
  558.          EndProperty
  559.          MousePointer    =   1
  560.          Style           =   4
  561.          PicturePlus     =   "POSTITSE.frx":03B0
  562.          PictureMinus    =   "POSTITSE.frx":0522
  563.          PictureLeaf     =   "POSTITSE.frx":0694
  564.          PictureOpen     =   "POSTITSE.frx":0806
  565.          PictureClosed   =   "POSTITSE.frx":0978
  566.       End
  567.    End
  568. End
  569. Attribute VB_Name = "postit"
  570. Attribute VB_Creatable = False
  571. Attribute VB_Exposed = False
  572.  
  573. Private Function checkswear()
  574.  
  575.  
  576.  
  577.     ' warning....
  578.     
  579.     
  580.     ' this function contains some horrible words - do not look if easily offended !
  581.     
  582.     ' this functions purpose is to check the entire message for swear words, and returns
  583.     ' 0 if the message is clean, or not 0 if dirty.
  584.     
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.  
  640.     D = UCase$(DATUM.Text) + " "
  641.  
  642.     For A = 1 To Len(D)
  643.         C = C + UCase$(Mid$(D, A, 1))
  644.     Next A
  645.     
  646.     D = " " + C
  647.  
  648.     S = 0
  649.     If InStr(D, "ASSHOLE") > 0 Then S = 1
  650.     If InStr(D, "ASS HOLE") > 0 Then S = 1
  651.     If InStr(D, "ARSEHOLE") > 0 Then S = 1
  652.     If InStr(D, "ARSE HOLE") > 0 Then S = 1
  653.     If InStr(D, "BLOODY") > 0 Then S = 1
  654.     If InStr(D, "BASTARD") > 0 Then S = 1
  655.     If InStr(D, "PRICK") > 0 Then S = 1
  656.     If InStr(D, "PENIS") > 0 Then S = 1
  657.     If InStr(D, "SHIT") > 0 Then S = 1
  658.     If InStr(D, "FUCK") > 0 Then S = 1
  659.     If InStr(D, "BOLLOCKS") > 0 Then S = 1
  660.     If InStr(D, " PISS") > 0 Then S = 1
  661.     
  662.     If InStr(D, "WANK ") > 0 Then S = 1
  663.     If InStr(D, "WANKER ") > 0 Then S = 1
  664.     If InStr(D, "WANKING ") > 0 Then S = 1
  665.     If InStr(D, "TODGER ") > 0 Then S = 1
  666.     If InStr(D, " ASS ") > 0 Then S = 1
  667.     If InStr(D, " ARSE ") > 0 Then S = 1
  668.     
  669.     If InStr(D, "DICKHEAD") > 0 Then S = 1
  670.     If InStr(D, " SOD ") > 0 Then S = 1
  671.     
  672.     If InStr(D, "VAGINA") > 0 Then S = 1
  673.     If InStr(D, " CLIT ") > 0 Then S = 1
  674.     If InStr(D, " CUNT ") > 0 Then S = 1
  675.     
  676.     If UCase$(Environ$("WINNAME")) = UCase$(PN_SUPERVISOR) Then S = 0
  677.  
  678.     checkswear = S
  679.  
  680. End Function
  681.  
  682.  
  683.  
  684. Private Sub Command3D3_Click()
  685.     
  686.     ' this is the listen to custom sound button
  687.     
  688.     Dim R As Integer
  689.     Const SYNC = 1
  690.      
  691.     ' obtain the proper file name
  692.     f = PN_SOUNDFILES + file1.filename
  693.     
  694.     ' go play that sound
  695.     R = sndPlaySound(ByVal f, SYNC)
  696.     
  697. End Sub
  698.  
  699.  
  700.  
  701. Private Sub Form_Load()
  702.     
  703.     ' center the form on the screen
  704.     Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
  705.     
  706.     Dim Ds As Recordset
  707.  
  708.     ' open the database (shared)
  709.     Set Db = OpenDatabase(PN_DATABASE, False)
  710.     
  711.     ' get a list of all users on the system
  712.     SQL$ = "Select * From [Post It Notes] Order By Department,[User name]"
  713.     
  714.     Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot)
  715.     
  716.     ' clear the address list, and then fill in the records
  717.     OUT1.Clear
  718.     
  719.     ' add the first node
  720.     OUT1.AddItem PN_NETWORK, 0
  721.     
  722.     C = 1    ' counter
  723.  
  724.     Od = ""  ' old department name
  725.     
  726.     ' loop through all the users, adding to the appropriate indentation level
  727.     
  728.     ' on a change of department name, set od to the new department name
  729.     ' this stops recursion routines being needed !
  730.     
  731.     While Not Ds.EOF
  732.  
  733.         ' check if the name being processed is the name we were called with (reply mode)
  734.         If Ds.Fields("WINDOWS NAME") = GlobCmd Then GlobCmd = Ds.Fields("USER NAME")
  735.  
  736.         If Ds.Fields("Department") <> Od Then
  737.             ' new department
  738.             ' add department at indent 1
  739.             OUT1.AddItem Ds.Fields("Department"), C
  740.             OUT1.Indent(C) = 1
  741.             C = C + 1
  742.             ' add user at indent 2
  743.             OUT1.AddItem Ds.Fields("User Name"), C
  744.             OUT1.Indent(C) = 2
  745.             C = C + 1
  746.             Od = Ds.Fields("Department")
  747.         Else
  748.             ' add user at indent 2
  749.             OUT1.AddItem Ds.Fields("User Name"), C
  750.             OUT1.Indent(C) = 2
  751.             C = C + 1
  752.         End If
  753.  
  754.         ' next record
  755.         Ds.MoveNext
  756.  
  757.     Wend
  758.  
  759.     Ds.Close
  760.  
  761.     ' go and expand all department nodes
  762.     For A = 0 To OUT1.ListCount - 1
  763.         
  764.         If OUT1.HasSubItems(A) Then OUT1.Expand(A) = True
  765.         
  766.     Next A
  767.     
  768.     
  769.     ' clear custom sound variable
  770.     GlobSound = ""
  771.  
  772.     DATUM.Text = ""
  773.  
  774.     ' AT THIS POINT, GLOBCMD WILL CONTAIN THE LONG NAME FOR THE USER.
  775.     If GlobCmd <> "" Then
  776.         
  777.         ' since we are in reply mode, we should change 'Send' to 'Reply'
  778.         sendit.Caption = "Reply"
  779.         
  780.         ' i think this code is obsolete, but i've left it in just in case  !
  781.         
  782.         ' find the user name
  783.         For A = 0 To (OUT1.ListCount - 1)
  784.             If OUT1.List(A) = GlobCmd Then
  785.                 Ind = A
  786.                 Exit For
  787.             End If
  788.         Next A
  789.  
  790.         ' show it
  791.         OUT1.ListIndex = A
  792.  
  793.         ' NEED TO FIND GROUP ABOVE...
  794.         For A = OUT1.ListIndex To 0 Step -1
  795.             If OUT1.Indent(A) = 1 Then
  796.                 OUT1.Expand(A) = True
  797.                 Exit For
  798.             End If
  799.         Next A
  800.               
  801.     End If
  802.  
  803. End Sub
  804.  
  805. Private Sub Form_Unload(Cancel As Integer)
  806.     
  807.     ' close the database (global)
  808.     Db.Close
  809.  
  810. End Sub
  811.  
  812. Private Sub out1_Click()
  813.     
  814.     ' handle expansion and contraction of the list box
  815.     If OUT1.HasSubItems(OUT1.ListIndex) Then
  816.     
  817.         If OUT1.Expand(OUT1.ListIndex) Then
  818.         
  819.             OUT1.Expand(OUT1.ListIndex) = False
  820.             
  821.         Else
  822.         
  823.             OUT1.Expand(OUT1.ListIndex) = True
  824.             
  825.         End If
  826.         
  827.     End If
  828.     
  829. End Sub
  830.  
  831. Private Sub SENDIT_Click()
  832.  
  833.     ' declare the snapshot variable (this should use recordset, but I haven't had time to alter it !)
  834.     Dim Ds As Recordset
  835.  
  836.     ' if we have an item selected...
  837.     If OUT1.ListIndex <> -1 Then
  838.     
  839.         ' check on the swearing content of the message
  840.         If checkswear() = 1 Then
  841.             A = MsgBox("Sorry I will not send that message - please clean up you language.", 16, "No Way!")
  842.             Exit Sub
  843.         End If
  844.  
  845.         ' display the sending message panel
  846.         sendingto.Visible = True
  847.         DoEvents
  848.  
  849.         ' IS THIS A SINGLE USER?
  850.   
  851.         ' a system always has an indent of 0
  852.         ' a group always has an indent of 1
  853.         ' a user always has an indent of 2
  854.         
  855.       If OUT1.Indent(OUT1.ListIndex) = 2 Then
  856.  
  857.             ' SINGLE USER.
  858.             
  859.             ' get the user address
  860.             SQL$ = "SELECT * FROM [POST IT NOTES] WHERE [USER NAME] = '" + OUT1.List(OUT1.ListIndex) + "'"
  861.             Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot)
  862.             
  863.             ToName = Ds.Fields("WINDOWS NAME")
  864.             Department = Ds.Fields("DEPARTMENT")
  865.             Ds.Close
  866.                     
  867.             Progress.Caption = "Initiate"
  868.                     
  869.             ' go and send the message to the user
  870.             If SendMulti(ToName, Department) <> "OK" Then
  871.                     ' fail - user not logged on
  872.                     A = MsgBox("The message has been added to the message queue for that user", 64, "For Your Information")
  873.             Else
  874.                     ' message sent
  875.                     A = MsgBox("Your message has been sent to the requested person.", 64, "For Your information")
  876.             End If
  877.         
  878.         
  879.         Else
  880.             
  881.             ' IS THIS THE GLOBAL LIST ?
  882.             If OUT1.ListIndex = 0 Then
  883.                 ' YES, GLOBAL...
  884.  
  885. '**********************************************************************************
  886. '**********************************************************************************
  887. '**********************************************************************************
  888.                 
  889.     ' This next section deals with the supervisor only group broadcast.
  890.  
  891.     ' change the name to whoever is your supervisor
  892.     
  893.     ' or change the code to whatever you like !
  894.     
  895. '**********************************************************************************
  896. '**********************************************************************************
  897. '**********************************************************************************
  898. '**********************************************************************************
  899.  
  900.  
  901.                 ' do we have rights to do this ?
  902.                 If UCase$(Environ$("WinName")) <> UCase$(PN_SUPERVISOR) Then
  903.                     
  904.                     A = MsgBox("Sorry, But You Do Not Have Enough Rights To Send A Message To All Personnel.", 64, "For Your Information")
  905.                 Else
  906.                     
  907.                     ' get addresses (entire list)
  908.                     SQL$ = "SELECT * FROM [POST IT NOTES] ORDER BY DEPARTMENT,[USER NAME]"
  909.                     Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot)
  910.                     
  911.                     ' loop through addresses, sending to all - note, no checking as to whether messages are actually sent here.
  912.                     While Not Ds.EOF
  913.                         
  914.                         ToName = Ds.Fields("WINDOWS NAME")
  915.                         Department = Ds.Fields("DEPARTMENT")
  916.                         Progress.Caption = "Initiate"
  917.                         DoEvents
  918.                         
  919.                         X = SendMulti(ToName, Department)
  920.                         Ds.MoveNext
  921.  
  922.                     Wend
  923.  
  924.                     Ds.Close
  925.  
  926.                 End If
  927.  
  928.             Else
  929.  
  930.                 ' we are dealing with a group.
  931.  
  932.                 ' THIS IS A GROUP.
  933.                 
  934.                 ' retrieve addresses for group
  935.                 SQL$ = "SELECT * FROM [POST IT NOTES] WHERE DEPARTMENT = '" + OUT1.List(OUT1.ListIndex) + "' ORDER BY [USER NAME]"
  936.                 Set Ds = Db.OpenRecordset(SQL$, dbOpenSnapshot)
  937.                 
  938.                 ' loop through and send messages to all users in a group
  939.                 While Not Ds.EOF
  940.                     
  941.                     ToName = Ds.Fields("WINDOWS NAME")
  942.                     Department = Ds.Fields("DEPARTMENT")
  943.                     Progress.Caption = "Initiate"
  944.                     DoEvents
  945.                     X = SendMulti(ToName, Department)
  946.                     Ds.MoveNext
  947.  
  948.                 Wend
  949.  
  950.                 Ds.Close
  951.  
  952.             End If
  953.  
  954.         End If
  955.  
  956.         ' hide the send panel
  957.         sendingto.Visible = False
  958.         DoEvents
  959.  
  960.  
  961.     Else
  962.         
  963.         ' oops - didn't select a user in the address list.
  964.         A = MsgBox("Please Select A Person To Send This Message To !", 64, "Oops!")
  965.  
  966.     End If
  967.  
  968.     Progress.Caption = ""
  969.     
  970. End Sub
  971.  
  972. Private Function SendMulti(UserNam, Department)
  973.     
  974.     SENDDEPARTMENT.Caption = ""
  975.     SENDUSER.Caption = ""
  976.     DoEvents
  977.  
  978.     ' declare recordset variables
  979.     Dim NoteDS As Recordset
  980.     
  981.     UserNam = Trim$(UserNam)
  982.     On Error Resume Next
  983.     
  984.     ' set a double ampersand string to a single ampersand string
  985.     X = InStr(Department, "& ")
  986.     If X <> 0 Then
  987.         XX = Left$(Department, X)
  988.         XX = XX + "& "
  989.         XX = XX + Right$(Department, X + 1)
  990.         Department = XX
  991.     End If
  992.  
  993.     SENDDEPARTMENT.Caption = Department
  994.     SENDUSER.Caption = UserNam
  995.     Progress.Caption = "Connect To Network"
  996.     DoEvents
  997.  
  998.  
  999.     EE = 0
  1000.     Err = 0
  1001.     
  1002.     
  1003.     ' repeat this loop 10 times - the other machine should have responded by then ! - if it hasn't, the machine is probably not logged on.
  1004.     While (EE < 10)
  1005.     
  1006.         DDE.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT"
  1007.             
  1008.         DDE.LinkItem = "CALLER"
  1009.         DDE.LinkMode = 1
  1010.         
  1011.         If Err <> 0 Then
  1012.             ' cancel the connection, add 1 to the retry count and try again
  1013.             DDE.LinkMode = 0
  1014.             EE = EE + 1
  1015.         Else
  1016.             ' we have a connection (this is quick and dirty code, should use boolean structures here)
  1017.             EE = 99
  1018.         End If
  1019.         
  1020.         ' reset the vb error code to clear.
  1021.         Err = 0
  1022.         
  1023.     Wend
  1024.     
  1025.             
  1026.         If EE = 99 Then
  1027.             Progress.Caption = "Start Send"
  1028.             DoEvents
  1029.  
  1030.             DDED.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT"
  1031.             DDED.LinkItem = "DATUM"
  1032.             DDED.LinkMode = 1
  1033.             
  1034.             DDEDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT"
  1035.             DDEDD.LinkItem = "SOUNDER"
  1036.             DDEDD.LinkMode = 1
  1037.             
  1038.             DDEDDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT"
  1039.             DDEDDD.LinkItem = "NAMER"
  1040.             DDEDDD.LinkMode = 1
  1041.             
  1042.             DDEDDDD.LinkTopic = "\\" + UserNam + "\NDDE$|POSTIT"
  1043.             DDEDDDD.LinkItem = "RECORDID"
  1044.             DDEDDDD.LinkMode = 1
  1045.                 
  1046.             For A = 0 To 6
  1047.                 If POPUP(A).Value = True Then B = A
  1048.             Next A
  1049.  
  1050.             ' select standard sounds
  1051.             Select Case B
  1052.                 Case 0: Snd = "POPUP"
  1053.                 Case 1: Snd = "HONKHONK"
  1054.                 Case 2: Snd = "SHIPBELL"
  1055.                 Case 3: Snd = "BUGLE"
  1056.                 Case 4: Snd = "PUKE"
  1057.                 Case 5: Snd = "KITTEN"
  1058.                 Case 6: Snd = GlobSound
  1059.             End Select
  1060.                 
  1061.             ' kludge
  1062.             If B < 6 Then Snd = Snd + ".WAV"
  1063.             
  1064.              ' WRITE THE INFORMATION OUT TO A USER.
  1065.             Progress.Caption = "Update Database"
  1066.             DoEvents
  1067.             
  1068.             SQL$ = "SELECT * FROM NOTELOG"
  1069.             Set NoteDS = Db.OpenRecordset(SQL$, dbOpenDynaset)
  1070.             
  1071.             On Error GoTo 0
  1072.  
  1073.             NoteDS.AddNew
  1074.             NoteDS.Fields("USERNAME") = UserNam
  1075.             NoteDS.Fields("DATE") = Now
  1076.             NoteDS.Fields("FROM") = UCase$(Environ$("USERNAME"))
  1077.             NoteDS.Fields("MESSAGE") = DATUM.Text
  1078.             NoteDS.Fields("SOUND") = PN_SOUNDFILES + Snd
  1079.             NoteDS.Fields("READ") = False
  1080.             If ReplyReq.Value = -1 Then NoteDS.Fields("REPLY_REQUIRED") = -1
  1081.             NoteDS.Update
  1082.             
  1083.             On Error Resume Next
  1084.             NoteDS.Bookmark = NoteDS.LastModified
  1085.             DoEvents
  1086.             
  1087.             Progress.Caption = "Transfer Message"
  1088.             DoEvents
  1089.             
  1090.             ' transfer the instructions over ndde to the other machine
  1091.             DDEDDDD.Text = Str$(NoteDS.Fields("RECORD_ID"))
  1092.             DDEDDDD.LinkPoke
  1093.             DDEDDDD.LinkMode = 0
  1094.             
  1095.             ' close the recordset
  1096.             NoteDS.Close
  1097.  
  1098.             DDEDD.Text = PN_SOUNDFILES + Snd
  1099.             DDEDD.LinkPoke
  1100.             DDEDD.LinkMode = 0
  1101.             
  1102.             DDEDDD.Text = Environ$("WINNAME")
  1103.             DDEDDD.LinkPoke
  1104.             DDEDDD.LinkMode = 0
  1105.             
  1106.             DDE.Text = "From : " + Environ$("USERNAME")
  1107.             DDE.LinkPoke
  1108.             DDED.Text = DATUM.Text
  1109.             DDED.LinkPoke
  1110.             DDED.LinkMode = 0
  1111.             DDE.LinkExecute ("OK")
  1112.             DDE.LinkMode = 0
  1113.                    
  1114.         End If
  1115.  
  1116.  
  1117.     ' decide what to return to the calling procedure
  1118.     If EE = 99 Then
  1119.     
  1120.         SendMulti = "OK"
  1121.         Progress.Caption = "Complete - OK"
  1122.             
  1123.     Else
  1124.     
  1125.         SendMulti = "error"
  1126.         Progress.Caption = "Complete - FAIL"
  1127.  
  1128.     End If
  1129.             
  1130.     DoEvents
  1131.  
  1132. End Function
  1133.  
  1134. Private Sub SSTab1_Click(PreviousTab As Integer)
  1135.  
  1136.     ' set the info field up
  1137.     Select Case SSTab1.Tab
  1138.         
  1139.         Case 0: infotab.Caption = "Enter The Message You Wish To Send"
  1140.         Case 1: infotab.Caption = "Select The User Or Group Of Users To Send It To"
  1141.         Case 2: infotab.Caption = "Select Either A Standard Or Custom Sound"
  1142.         Case 3: infotab.Caption = "Select Any Message Options"
  1143.         
  1144.     End Select
  1145.     
  1146.     DoEvents
  1147.     
  1148. End Sub
  1149.  
  1150. Private Sub SSTab2_Click(PreviousTab As Integer)
  1151.  
  1152.     ' display the custom sounds - uses file list box.
  1153.  
  1154.     If SSTab2.Tab = 1 Then
  1155.         
  1156.         postit.file1.Path = PN_SOUNDFILES
  1157.         
  1158.         postit.file1.Pattern = "*.WAV"
  1159.         postit.file1.Enabled = True
  1160.         
  1161.         DoEvents
  1162.         
  1163.     End If
  1164.     
  1165. End Sub
  1166.  
  1167.  
  1168.